REM Hilfsmittel zur Analysis
REM ------------------------
REM 
REM benutzte Variablen :
REM
REM   xu, xo     : Intervallgrenzen
REM   ymin, ymax : groesster und kleinster Funktionswert im angegebenen Intervall
REM   sx, dy, dx : Schrittweite mit der gearbeitet wird
REM   a$, a      : Hilfsvariablen
REM   ein$       : Ausgabe aus EINGABE-Routine
REM
REM  

  CLEAR,50000,10000
  DEFDBL a-z
  DIM fkt(700,1),fktzl%(700)
  ON ERROR GOTO Fehler

  DEF FNf(x)=(x*x)/x
  
  

REM Unterprogramme
REM --------------

SUB eingabe(ein$) STATIC
    ein$=""
  l1:
    a$=INPUT$(1)
    a=ASC(a$)
    IF (a<48 OR a>57) AND (a<>13) AND (a<>8) AND (a<>43) AND (a<>45) AND (a<>46) THEN GOTO l1
    IF a=8 AND LEN(ein$)>0 THEN ein$=LEFT$(ein$,LEN(ein$)-1):PRINT a$;
    IF LEN(ein$)>=6 THEN GOTO l2
    IF (a>=48 AND a<=57) OR a=43 OR a=45 OR a=46 THEN ein$=ein$+a$:PRINT a$;
  l2:
    IF a<>13 THEN GOTO l1
    END SUB

SUB ExakteNullstelle(x,sx,i) STATIC
    xl=x
    xr=x+sx
    xm=(xl+xr)/2
  l3:
    IF FNf(xl)*FNf(xm)<=0 THEN xr=xm :ELSE xl=xm
    xm=(xl+xr)/2
    IF xr-xl>1e-05 THEN GOTO l3:      
    LOCATE i,10:PRINT "x = ";USING "#######.####";xm
    LOCATE i,30:PRINT ", f(x) = 0"    
    i=i+1
    END SUB

SUB InitScreen2 STATIC
    SCREEN 2,640,256,3,2
    WINDOW 2,"",(0,0)-(631,242),0,2
    CLS
    PALETTE 0,0,0,0
    PALETTE 1,0,0,0
    PALETTE 2,1,1,0.8
    PALETTE 3,1,1,0.7
    PALETTE 4,1,1,0.5
    PALETTE 5,0,1,0
    PALETTE 6,1,0,0
    PALETTE 7,0.3,0.3,0.3
    END SUB

    
  CALL InitScreen2
hauptmenu:
  REM Hauptmenue
  REM ----------
  COLOR 2
  LOCATE 8,22:PRINT "Intervallgrenzen eingeben........1"
  COLOR 3
  LOCATE 10,22:PRINT "Wertetabelle ausgeben............2"
  COLOR 2
  LOCATE 12,22:PRINT "Funktionsanalyse.................3"
  COLOR 3
  LOCATE 14,22:PRINT "Graphen zeichen..................4"
  COLOR 2
  LOCATE 16,22:PRINT "Programm beenden.................0"
  COLOR 4
  LOCATE 19,22:PRINT "Ihre Eingabe             : (0-4) ";
  COLOR 2
  
lbl1:
  a$=INPUT$(1)
  IF ASC(a$)<48 OR ASC(a$)>52 THEN GOTO lbl1
  a=VAL(a$)
  
  IF a=0 THEN SCREEN CLOSE 2:ON ERROR GOTO 0:END
  ON a GOSUB intervallgrenzen,wertetabelle,analyse,graph
  WINDOW OUTPUT 2
  GOTO hauptmenu
        


intervallgrenzen:
    interflag=1
    WINDOW 3,"",(0,0)-(631,242),0,2
    COLOR 2
    LOCATE 8,20:PRINT "Bitte geben Sie die Intervallgrenzen an,"
    LOCATE 10,20:PRINT "in denen die Funktion untersucht werden"
    LOCATE 12,20:PRINT "soll."
  
  lbl2:
    COLOR 4
    LOCATE 15,20:PRINT "untere Intervallgrenze :            ";
    LOCATE 15,45:
    COLOR 2
    CALL eingabe(ein$)
    xu=VAL(ein$)
    COLOR 4
    LOCATE 16,20:PRINT "obere Intervallgrenze  :            ";
    LOCATE 16,45
    COLOR 2
    CALL eingabe(ein$)
    xo=VAL(ein$)
    IF xo<xu THEN SWAP xu,xo
    IF xo=xu THEN GOTO lbl2 
  
    WINDOW CLOSE 3
    SCREEN CLOSE 2
    COLOR 2
    LOCATE 2,6:PRINT "Einen Moment bitte.";
    dx2=(ABS(xu)+ABS(xo))/631
    ymin=FNf(xu):xr=xu
    ymax=FNf(xu):xl=xu
    i=0
    FOR x =xu TO xo+dx2 STEP dx2
      y=FNf(x)
      IF errorflag=1 THEN 
          errorflag=0
          fktzl%(i)=1
        ELSE 
          IF y>ymax THEN ymax=y:xl=x 
          IF y<ymin THEN ymin=y:xr=x
          fktzl%(i)=0
      END IF
      fkt(i,0)=x
      fkt(i,1)=y
      i=i+1
    NEXT x
    dy=242/(ABS(ymin)+ABS(ymax))
    dx=631/(ABS(xu)+ABS(xo))      
    dy2=(ABS(ymin)+ABS(ymax))/242
    xv=ABS(xu*dx)
    yv=ABS(ymin*dy)
    CALL InitScreen2
    RETURN
    
wertetabelle:
    IF interflag=0 THEN RETURN
    WINDOW 3,"",(0,0)-(631,242),0,2
    COLOR 4
    LOCATE 2,24:PRINT "x"
    LOCATE 2,41:PRINT "f(x)"
   
    i=0
    j=0
    FOR x=xu TO xo+dx2 STEP dx2*10
      i=i+1
      COLOR (i AND 1)+2
      LOCATE 4+i,20:PRINT STRING$(50," ")
      LOCATE 4+i,17:PRINT USING "#######.######";fkt(j,0) 
      LOCATE 4+i,35 
      IF fktzl%(j)=0 THEN PRINT USING "#######.######";fkt(j,1) ::ELSE PRINT "      ---        " 
      IF i>=15 THEN WHILE INKEY$="": WEND:i=0
      j=j+10
    NEXT x
    FOR x=i+1 TO 15
      LOCATE 4+x,20:PRINT STRING$(50," ")
    NEXT x
  
    WHILE INKEY$="": WEND
    WINDOW CLOSE 3
    RETURN

analyse:
    IF interflag=0 THEN RETURN
    
    WINDOW 3,"",(0,0)-(631,242),0,2
    COLOR 5
    LOCATE 5,10:PRINT "Nullstellen"
    COLOR 2
  
    j=0
    i=7
    FOR x=xu TO xo-dx2 STEP dx2
      IF fktzl%(j)=1 OR fktzl%(j+1)=1 THEN GOTO lbl8
      y=fkt(j,1)*fkt(j+1,1)
      IF y<=0 THEN CALL ExakteNullstelle(x,dx2,i)
  lbl8:
      j=j+1
    NEXT x
  
analyse2:
    COLOR 5
    LOCATE i+3,10:PRINT "Extrema"
    COLOR 2
    LOCATE i+5,10:PRINT "Maximum an x=";USING "#######.####";xl
    LOCATE i+5,50:PRINT ", f(x)=";USING "#######.####";ymax
    LOCATE i+6,10:PRINT "Minimum an x=";USING "#######.####";xr
    LOCATE i+6,50:PRINT ", f(x)=";USING "#######.####";ymin
  
    WHILE INKEY$="":WEND
    WINDOW CLOSE 3
    RETURN


graph:
    IF interflag=0 THEN RETURN
    WINDOW 3,,(0,0)-(631,242),0,2
  
    dx3=(ABS(xu)+ABS(xo))/10
    dy3=(ABS(ymin)+ABS(ymax))/10

    COLOR 2
    LOCATE 8,20:PRINT "Der Graph wird im Intervall [";
    PRINT USING "#######.####";xu;
    PRINT ";";
    PRINT USING "#######.####";xo;
    PRINT "]"
    LOCATE 10,20:PRINT "gezeichnet."
    LOCATE 12,20:PRINT "Der Abstand zwischen den Hilfspunkten beträgt"
    LOCATE 14,20:PRINT "in  X-Richtung : ";
    PRINT USING "####.####";dx3
    LOCATE 16,20:PRINT "    Y-Richtung : ";
    PRINT USING "####.####";dy3
    COLOR 4
    LOCATE 19,20:PRINT "Wollen Sie die Abstände ändern ? (j/n) :";

  lbl4:
    a$=""
    WHILE a$<>"j" AND a$<>"n"
      a$=INKEY$
    WEND
    IF a$="n" THEN GOTO lbl5
  
    REM Abstaende aendern
    REM -----------------
    CLS
  lbl6:
    COLOR 3
    LOCATE 9,20:PRINT "Abstand in X-Richtung : ";
    PRINT USING "####.####";dx3
    LOCATE 11,20:PRINT "          Y-Richtung : ";
    PRINT USING "####.####";dy3
    COLOR 4
    LOCATE 15,20:PRINT "Abstand in X-Richtung  :              "
    LOCATE 15,46
    COLOR 2
    CALL eingabe(ein$)
    dx3=VAL(ein$)
    IF dx3<=0 THEN GOTO lbl6

  lbl7:  
    COLOR 4  
    LOCATE 17,20:PRINT "Abstand in Y-Richtung  :              "
    LOCATE 17,46
    COLOR 2
    CALL eingabe(ein$)
    dy3=VAL(ein$)
    IF dy3<=0 THEN GOTO lbl7
  
  lbl5:
    REM Graph zeichnen
    REM --------------  
    CLS
  
    LINE (0,242-yv)-(631,242-yv),6
    LINE (xv,0)-(xv,242),6
    LINE (xv,0)-STEP(5,5),6
    LINE (xv,0)-STEP(-5,5),6
    LINE (631,242-yv)-STEP(-5,3),6
    LINE (631,242-yv)-STEP(-5,-3),6
  
    i=0
    WHILE fktzl%(i)<>0
      i=i+1
    WEND
    PSET (xv+fkt(i,0)*dx,242-(yv+fkt(i,1)*dy)),5
    i=0
    FOR x=xu TO xo STEP dx2
      xk=xv + fkt(i,0)*dx
      yk=242-(yv + fkt(i,1)*dy)
      IF fktzl%(i)=0 THEN LINE -(xk,yk),5 
      i=i+1
    NEXT x
  
    FOR x=0 TO xo STEP dx3
      FOR y=0 TO ymax STEP dy3
        PSET (xv+x*dx,242-yv-y*dy),7
      NEXT y
    NEXT x
    FOR x=0 TO xo STEP dx3
      FOR y=0 TO ymin STEP -dy3
        PSET (xv+x*dx,242-yv-y*dy),7
      NEXT y
    NEXT x
    FOR x=0 TO xu STEP -dx3
      FOR y=0 TO ymin STEP -dy3
        PSET (xv+x*dx,242-yv-y*dy),7
      NEXT y
    NEXT x
    FOR x=0 TO xu STEP -dx3
      FOR y=0 TO ymax STEP dy3
        PSET (xv+x*dx,242-yv-y*dy),7
      NEXT y
    NEXT x

    WHILE INKEY$="":WEND
    WINDOW CLOSE 3
    RETURN

Fehler:
  REM Fehlerbehandlung
  REM ----------------
  a=ERR
  IF a=11 OR a=6 OR a=5THEN 
      errorflag=1
      RESUME NEXT
    ELSE
      REM falls Programmfehler
      WINDOW CLOSE 2
      WINDOW CLOSE 3
      SCREEN CLOSE 2
      ON ERROR GOTO 0
      CLEAR
      END
  END IF